home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / dndbbs.arc / DND-SRC.LBR / DNDBBS.BAS next >
Encoding:
BASIC Source File  |  2011-01-29  |  3.4 KB  |  53 lines
  1. 10 DEFSTR A-B:DEFINT C-Z:DIM TS(12):COMMON SHARED /DNDBBS.PGM/ T2!,UX,LM,CX!,LR,RM,A,WR,CR,AL,FG,IN,TF,YE,AI,NX,CA,SW,PA1$,PA2$,E1$,Z8$,TS(),X1:ON ERROR GOTO 510
  2. 20 DIM A2(6),F1$(4):CLOSE 1:OPEN "I",1,"DNDBBS.CNF":LINE INPUT #1,PA1$:LINE INPUT #1,PA2$:FOR L=1 TO 4:LINE INPUT #1,F1$(L):F1$(L)=PA1$+F1$(L):NEXT:E1$=F1$(4):FOR LP=1 TO 12:INPUT #1,TS(LP):NEXT
  3. 30 DEF FNTIM$=RIGHT$(DATE$,2)+" "+MID$("JanFebMarAprMayJunJulAugSepOctNovDec",VAL(LEFT$(DATE$,2))*3-2,3)+" "+MID$(DATE$,4,2)+","+STR$(VAL(LEFT$(TIME$,2))+12*(VAL(LEFT$(TIME$,2))>12))+MID$(TIME$,3,6)+MID$(" am pm",(1-(VAL(LEFT$(TIME$,2))>12))*3-2,3)
  4. 40 KEY OFF:CLS:Z8$="":CL=-1:CK=-1:CX!=600:LM=0:UX=0:CLOSE 3:OPEN "R",3,PA1$+"USERS.DAT",256
  5. 50 FIELD 3,80 AS B7,30 AS AN,20 AS PS$,20 AS A2,1 AS A1,2 AS A2(1),2 AS A2(2),2 AS A2(3),2 AS A2(4),2 AS A2(5),2 AS A2(6),10 AS B7,2 AS RO$,2 AS B4
  6. 60 FIELD 3,177 AS B7,8 AS A9,8 AS BT,1 AS B1,2 AS B9,2 AS BC, 2 AS V4$,2 AS V5$,2 AS BR,2 AS BP,2 AS BZ,2 AS B7,2 AS BH,2 AS B7,2 AS LCK$,2 AS B7,8 AS AD,8 AS AE,10 AS AC
  7. 70 GOSUB 170:OUT 1020,1:OUT 1019,3:A="ATZ":GOSUB 130:GOSUB 170
  8. 80 A="ATQ1E0S2=255S0=1":GOSUB 130:CLS:PRINT"SYSOP HIT [ESCAPE] TO ENTER LOCAL":PRINT "WAITING FOR CALLS..":A=""
  9. 90 IF(INP(1021)AND 1) THEN DUMY=INP(1016)
  10. 100 X$=INKEY$:IF X$=CHR$(27)THEN LM=-1:T2!=TIMER:OUT 1020,0:CLS:GOTO 190
  11. 110 IF INP(1022)<128 THEN 90
  12. 120 T2!=TIMER:OUT 1019,131:OUT 1016,128:OUT 1017,1:OUT 1019,3:GOTO 190
  13. 130 A=A+CHR$(13):FOR LA=1 TO LEN(A)
  14. 140 IF(INP(1021)AND 1)THEN DUMY=INP(1016)
  15. 150 IF(INP(1021)AND 32)=0 THEN 140
  16. 160 OUT 1016,ASC(MID$(A,LA,1)):NEXT:RETURN
  17. 170 T!=TIMER+2
  18. 180 IF TIMER<T!AND T!<86400! THEN 180 ELSE RETURN
  19. 190 BD=F1$(1):GOSUB 440
  20. 200 CALL IO.O:A="Codename? ":FG=30:CALL IO.I:GOSUB 480:GOSUB 490:AO=AL:IF AL="" THEN 200
  21. 220 CALL IO.O:A="Password? ":FG=20:CALL IO.I:GOSUB 480:GOSUB 490:AF=AL:IF AL="" THEN 220
  22. 240 FOR UX=1 TO LOF(3)/256:GET 3,UX
  23. 250 IF AN=AO+STRING$(30-LEN(AO),32) THEN IF PS$=AF+STRING$(20-LEN(AF),32) THEN 290 ELSE 200
  24. 260 NEXT:FOR UX=1 TO LOF(3)/256:GET 3,UX:IF LEFT$(AN,8)<>"ZZZZZNUL" THEN NEXT:GET 3,UX
  25. 270 LSET AN=AO:LSET PS$=AF:LSET AC=DATE$
  26. 280 PUT 3,UX:C8=1:A="Remember your password.":CALL IO.O
  27. 290 IF AC<>DATE$ THEN C8=1:LSET AC=DATE$ ELSE C8=VAL(B1)
  28. 300 C2=VAL(A1):IF LM OR C2=7 THEN CX!=180000!:GOTO 340
  29. 310 C8=C8+1:IF C8>3 THEN A="Sorry, you have exceeded the call limit restriction!":CALL IO.O:BD=F1$(4):GOSUB 440:OUT 1020,0:GOTO 40
  30. 320 LSET B1=RIGHT$(STR$(C8),1):PUT 3,UX
  31. 330 I4=0:IF LF>1 THEN CX!=1800 ELSE CX!=1500
  32. 340 BD=F1$(3):GOSUB 440
  33. 350 A="Welcome "+CHR$(34)+AO+CHR$(34)
  34. 360 BD=F1$(2):GOSUB 440
  35. 370 CALL DND
  36. 380 IF TIMER=>T2!THEN T3!=TIMER-T2! ELSE T3!=TIMER+86400!-T2!
  37. 390 A="You were on for"
  38. 400 T5!=INT(T3!/60!)
  39. 410 T4!=T3!-T5!*60!:IF T5!=0 THEN A=A+STR$(INT(T4!))+" sec.":GOTO 430
  40. 420 IF T5!>60! THEN A=A+" more than an hour." ELSE A=A+STR$(T5!)+" min.":IF T4! THEN A=A+" and"+STR$(INT(T4!))+" sec." ELSE A=A+"."
  41. 430 T2!=TIMER:CALL IO.O:BD=F1$(4):GOSUB 440:GOTO 40
  42. 440 CLOSE 1:OPEN "R",1,BD,1:IF LOF(1)=0 THEN 470
  43. 450 CLOSE 1:OPEN "I",1,BD:WHILE EOF(1)=0:LINE INPUT#1,A:CALL IO.O
  44. 460 WEND
  45. 470 CLOSE 1:RETURN
  46. 480 FOR UC=1 TO LEN(AL):UC1=ASC(MID$(AL,UC,1)):MID$(AL,UC,1)=CHR$(UC1+32*(UC1>96 AND UC1<123)):NEXT:RETURN
  47. 490 IF LEFT$(AL,1)=" " THEN AL=MID$(AL,2):GOTO 490
  48. 500 RETURN
  49. 510 IF ERL=20 THEN PRINT "BAD OR MISSING CONFIGURATION FILE":RESUME 550
  50. 520 IF ERR=75 OR ERR=76 THEN PRINT "BAD PATHNAME -- RUN CONFIGURATION PROGRAM":RESUME 550
  51. 530 PRINT "Error"ERR"in module DNDBBS number"ERL
  52. 540 RESUME NEXT
  53. 550 E